PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/tvgraph.exe/STYX.PAS

Pascal/Delphi Source File | 1992-07-29 | 4.9 KB | 224 lines

{************************************************}
{                                                }
{   Turbo Pascal 6.0                             }
{   Turbo Vision Demo                            }
{   Copyright (c) 1990 by Borland International  }
{                                                }
{************************************************}

unit Styx;

{$F+,O-,X+,S-,D+,L+}

{ Graphics Styx demo }

interface

uses TvGraph, DemoCmds, Objects, App, Views, Drivers;

type
  XYCord = record
   XA,YA,XB,YB:integer;
  end;
  PStyx = ^TStyx;
  TStyx = object(TView)
    (* use as bit map *)
    GraphWindowId:byte;
    CurrentStick:byte;
    Velocity:XYCord;
    StyxLocations:Array[0..15] of XYCord;
    constructor Init(Var Bounds:Trect);
    destructor Done;virtual;
    procedure Prod;
    procedure Draw; virtual;
    procedure GetGraphBounds(var R:GRect);
    procedure GetGraphClipRect(var R:GRect);
    procedure HandleEvent(var Event:TEvent); virtual;
  end;

  PStyxDemo = ^TStyxDemo;
  TStyxDemo = object(TWindow)
    constructor Init;
  end;

const
  AsciiTableCommandBase: Word = 910;

  RStyx: TStreamRec = (
     ObjType: 10090;
     VmtLink: Ofs(TypeOf(TStyx)^);
     Load:    @TStyx.Load;
     Store:   @TStyx.Store
  );
  RStyxDemo: TStreamRec = (
     ObjType: 10091;
     VmtLink: Ofs(TypeOf(TStyxDemo)^);
     Load:    @TStyxDemo.Load;
     Store:   @TStyxDemo.Store
  );

procedure RegisterStyx;

implementation

constructor TStyx.Init(Var Bounds:Trect);
var
 R:GRect;
begin
 TView.Init(Bounds);
 CurrentStick:=0;
 GrowMode:=gfGrowHiX+GfGrowHiY;
 fillchar(StyxLocations,Sizeof(StyxLocations),#0);
 (* Assume all available *)
 GraphWindowId:=NextGraphId;
 UseGraphId(GraphWindowId);
 GetGraphBounds(R);
 with Styxlocations[0] do
 with R do
 begin
    XA:=(B.X-A.X) div 2;
    YA:=(B.Y-A.Y) div 2;
    XB:=(B.X-A.X) div 3;
    YB:=(B.Y-A.Y) div 3;
 end;
 with Velocity do
 begin
    XA:=random(4)+1;if XA>2 then XA:=2-XA;
    XA:=XA*16;
    YA:=random(4)+1;if YA>2 then YA:=2-YA;
    YA:=YA*16;
    XB:=random(4)+1;if XB>2 then XB:=2-XB;
    XB:=XB*16;
    YB:=random(4)+1;if YB>2 then YB:=2-YB;
    YB:=YB*16;
 end;
end;

procedure TStyx.GetGraphBounds(var R:GRect);
begin
  GetExtent(R);
  MakeGlobal(R.A,R.A);
  MakeGlobal(R.B,R.B);
  TextToGraphics(R,R);
end;

procedure TStyx.GetGraphClipRect(var R:GRect);
begin
  GetClipRect(R);
  MakeGlobal(R.A,R.A);
  MakeGlobal(R.B,R.B);
  TextToGraphics(R,R);
end;

procedure TStyx.Draw;
var
  Buf: TDrawBuffer;
  Y: Integer;
  Color: Byte;
  R:TRect;
begin
  GetExtent(R);
  MakeGlobal(R.A,R.A);
  MakeGlobal(R.B,R.B);
  Color := 255;
  MoveChar(Buf, Char(GraphWindowId), Color, Size.X);
  for Y:=0 to Size.Y-1 do
    WriteLine(0, Y, Size.X, 1, Buf);
  Prod;
end;

procedure TStyx.Prod;
const
 StyxColor:array[0..15] of byte =(15,11,11,9,9,9,9,1,1,1,1,1,1,1,1,0);
var
 Count:byte;
 Actual:byte;
 R:GRect;
 LS:byte;
 XMax,YMax:word;
begin
 UseGraphId(GraphWindowId);
 LS:=CurrentStick;
 CurrentStick:=(CurrentStick+1) mod 16;
 GetGraphBounds(R);
 XMax:=R.B.X-R.A.X-1;
 YMax:=R.B.Y-R.A.Y-1;
 with Styxlocations[CurrentStick] do
   with R do
   begin
      XA:=Styxlocations[LS].XA+Velocity.XA;
      if (XA<0) or (XA>XMax) then
      begin
       Velocity.XA:=-Velocity.XA;
       if XA<0 then XA:=0 else XA:=XMax
      end;
      XB:=Styxlocations[LS].XB+Velocity.XB;
      if (XB<0) or (XB>XMax) then
      begin
       Velocity.XB:=-Velocity.XB;
       if XB<0 then XB:=0 else XB:=XMax
      end;
      YA:=Styxlocations[LS].YA+Velocity.YA;
      if (YA<0) or (YA>YMax) then
      begin
       Velocity.YA:=-Velocity.YA;
       if YA<0 then YA:=0 else YA:=YMax
      end;
      YB:=Styxlocations[LS].YB+Velocity.YB;
      if (YB<0) or (YB>YMax) then
      begin
       Velocity.YB:=-Velocity.YB;
       if YB<0 then YB:=0 else YB:=YMax
      end;
   end;
   for count:=0 to 15 do
   begin
    Actual:=(16-Count+CurrentStick) mod 16;
    with Styxlocations[Count] do
       DrawLine(R.A.X+XA,R.A.Y+YA,R.A.X+XB,R.A.Y+YB,StyxColor[Actual]);
   end;
end;

procedure TStyx.HandleEvent(var Event:TEvent);
var
  CurrentSpot: TPoint;
begin
  if (Event.What=evCommand) and (Event.Command=cmProdStyx) then
  begin
    Prod;
    ClearEvent(Event);
  end;
  TView.HandleEvent(Event);
end;

destructor TStyx.Done;
begin
 TView.Done;
 ReleaseGraphId(GraphWindowId);
end;

constructor TStyxDemo.Init;
var
  R: TRect;
  Control: PVIew;
begin
  R.Assign(0, 0, 34, 12);
  TWindow.Init(R, 'S T Y X', wnNoNumber);
{  Flags := Flags and not (wfGrow + wfZoom);}
  GetExtent(R);
  R.Grow(-1,-1);
  Control := New(PStyx, Init(R));
  with Control^ do
    Options := Options or ofFramed;
  Insert(Control);
  Control^.Select;
end;

procedure RegisterStyx;
begin
  RegisterType(RStyx);
  RegisterType(RStyxDemo);
end;

end.